home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1994 December / PSL Monthly Shareware CD-ROM (Public Software Library)(December 1994).bin / prgmming / dos / pascal1 / dk.pas < prev    next >
Pascal/Delphi Source File  |  1990-03-05  |  7KB  |  272 lines
  1. PROGRAM DIRKILLPROG;
  2. { Recursive descent directory/file deletion program. }
  3.  
  4.  
  5. (*
  6.  
  7.  Programmed for Turbo Pascal 5.5 (should work with 4.0 and 5.0). 
  8.  Will give a run-time error if you kill the directory that the   
  9.  executable resides in, but the error comes after all is finished, 
  10.  so it doesn't really matter. }
  11.  
  12.  
  13.  This program will remove all files and child directories (and their 
  14.  files too) of the specified directory. 
  15.  
  16.  For example, you have the following directory structure on a disk....
  17.  
  18.  
  19.  Root --> \SUBDIR1  --> A bunch of files
  20.                     --> \SUBDIR1\SUBDIR1.1 --> A bunch more files
  21.                     --> \SUBDIR1\SUBDIR1.2 --> Yet another bunch of files
  22.       --> \SUBDIR2
  23.       --> \SUBDIR3
  24.  
  25.  Using the DOS 'RD' commmand, you would not be able to remove \SUBDIR1
  26.  without first erasing all the files in it and the files in SUBDIR1.1
  27.  and the files in SUBDIR1.2 and 'RD'ing SUBDIR1.1 and SUBDIR1.2...
  28.  
  29.  This can be quite time consuming.   You could instead just type
  30.  'dk \subdir1', answer 'y' to the 'are you sure' prompt and wait
  31.  a few seconds while your computer does the work for you.  
  32.  
  33.  There is one CAVEAT to using this program.  It is quite powerful and
  34.  only asks 'are you sure' once.  If you were to type 'dk c:\' and 
  35.  answer 'y', all files and subdirectories on drive C: would be 
  36.  erased/removed.  
  37.  
  38.  The 'DIRKILL' procedure can be easily modified to do other useful things. 
  39.  For instance, if you wanted to back-up all the pascal source code on a hard
  40.  disk (or in a large set of directories) to a floppy, you could change the 
  41.  file mask (*.* for erasing) to  *.pas and instead of erasing files, 
  42.  you could put in code to copy files.  You would probably also want to
  43.  take out the line of code that removes a directory (last line in DIRKILL).
  44.  
  45.  The recursive descent method that is the basis for this program is 
  46.  quite useful in the MS-DOS hierarchical file system for performing 
  47.  manipulations on sets of files that may be in many directories with
  48.  a common parent directory.
  49.  
  50.  I hope you find this program useful.  I release this software to the
  51.  public domain, so enjoy it.  
  52.  
  53.  
  54.  P. S.  If you accidentally wipe out files/directories, they should be
  55.         recoverable by any utility that can recover from errant 'rd' 
  56.         and 'erase' commands.
  57.  
  58. *)
  59.  
  60.  
  61. uses
  62.    DOS, CRT;
  63.  
  64.  
  65. FUNCTION UPCASESTR(sTempStr : String) : String;
  66. { Force all alphabetic characters to upper case. }
  67. var
  68.    II : Integer;
  69.  
  70. begin
  71. for II := 1 to length(sTempStr) do
  72.    sTempStr[II] := upcase(sTempStr[II]);
  73.  
  74. UPCASESTR := sTempStr;
  75. end; { UPCASESTR }
  76.  
  77.  
  78. FUNCTION PROCESSPATH(var sTempStr : String) : Boolean;
  79. { Verify that SS is a valid path string. }
  80. var
  81.    bRetVal   : Boolean;
  82.    sWorkStr  : String;
  83.    sCurrPath : String;
  84.  
  85. begin
  86. bRetVal  := False;
  87. sWorkStr := sTempStr;
  88.  
  89. if (sWorkStr[1] <> '\') then
  90.    begin
  91.    if (sWorkStr[1] in ['A'..'Z']) and (sWorkStr[2] = ':') then
  92.       begin
  93.       if (length(sWorkStr) = 2) then
  94.          sWorkStr := concat(sWorkStr,'\');
  95.       end { if }
  96.    else
  97.       begin
  98.       getdir(0,sCurrPath);
  99.       if (sCurrPath[length(sCurrPath)] = '\') then
  100.          sWorkStr := concat(sCurrPath,sWorkStr)
  101.       else
  102.          sWorkStr := concat(sCurrPath,'\',sWorkStr);
  103.       end; { else }
  104.    end; { if }
  105.  
  106. chdir(sWorkStr);
  107. if (IOResult = 0) then
  108.    begin
  109.    sTempStr := sWorkStr;
  110.    bRetVal  := True;
  111.    end { if }
  112. else
  113.    begin
  114.    writeln;
  115.    writeln('Directory not found (',sWorkStr,').  Program aborted.');
  116.    end; { else }
  117.  
  118. PROCESSPATH := bRetVal;
  119. end; { PROCESSPATH }
  120.  
  121.  
  122. FUNCTION WARNING(sTempStr : String) : Boolean;
  123. { Verify user intentions. }
  124. var
  125.    iYY     : Integer;
  126.    sPrompt : String;
  127.    sAnswer : String;
  128.    bRetVal : Boolean;
  129.  
  130. begin
  131. bRetVal := False;
  132.  
  133. writeln;
  134. writeln;
  135. writeln;
  136.  
  137. { Save y-location. }
  138. iYY := WhereY - 2;
  139.  
  140. { Build & display prompt string. }
  141. sPrompt := concat('Deleting directory "',sTempStr,'".  Are you sure (Y/N): ');
  142. gotoxy(1,iYY);
  143. write(sPrompt);
  144.  
  145. { Loop until user presses Y/N or breaks out of application. }
  146. repeat
  147.    { Clear answer area. }
  148.    gotoxy(length(sPrompt) + 1, iYY);
  149.    write(' ':80 - (length(sPrompt) + 1));
  150.  
  151.    { Read user's answer. }
  152.    gotoxy(length(sPrompt) + 1, iYY);
  153.    readln(sAnswer);
  154.  
  155.    { Judge it. }
  156.    if (sAnswer[1] in ['Y','y']) then
  157.       bRetVal := True;
  158. until (sAnswer[1] in ['Y','y','N','n']);
  159.  
  160. WARNING := bRetVal;
  161. end; { WARNING }
  162.  
  163.  
  164. PROCEDURE DIRKILL(sWorkDir : String);
  165. { Recursive descent portion of program.  Does the real work. }
  166. var
  167.    srTemp     : SearchRec;
  168.    KillFile   : File;
  169.    sSaveStr   : String;
  170.    sTestStuff : String;
  171.  
  172. begin
  173. chdir(sWorkDir);
  174. sSaveStr := sWorkDir;
  175.  
  176. { Make sure there is a terminating backslash. }
  177. if (sWorkDir[length(sWorkDir)] <> '\') then
  178.    sWorkDir := concat(sWorkDir,'\');
  179.  
  180. findfirst(sWorkDir + '*.*', AnyFile, srTemp);
  181. while (DosError = 0) do
  182.    begin
  183.    { Ignore the '.' and '..' entries common to all directories. }
  184.    if (srTemp.Name[1] <> '.') then
  185.       begin
  186.  
  187.       { Is it a directory entry? }
  188.       if ((srTemp.Attr and Directory) <> 0) then
  189.          begin
  190.          DIRKILL(concat(sWorkDir, srTemp.Name));
  191.          end { if }
  192.  
  193.       { else, it isn't a directory, so delete it. }
  194.       else
  195.          begin
  196.          { THIS IS WHERE THE FILE ERASING HAPPENS. }
  197.          assign(KillFile, srTemp.Name);
  198.  
  199.          { Make sure we kill hidden, system, and read/only files. }
  200.          setfattr(KillFile, 0);
  201.  
  202.          {$I-}
  203.          reset(KillFile);
  204.          close(KillFile);
  205.          erase(KillFile);
  206.          {$I+}
  207.  
  208.          end; { else }
  209.       end; { if }
  210.  
  211.    findnext(srTemp);
  212.    end; { while }
  213.  
  214. { Back out of the directory. }
  215. {$I-}
  216. chdir('..');
  217. getdir(0,sTestStuff);
  218. {$I+}
  219.  
  220. { Remove directory we just backed out of. }
  221. writeln('Deleting ',sSaveStr,'...');
  222.  
  223. { THIS IS WHERE THE DIRECTORY REMOVING HAPPENS. }
  224. rmdir(sSaveStr);
  225. end; { DIRKILL }
  226.  
  227.  
  228.  
  229. var
  230.    sTempStr : String;
  231.    sOldDir  : String;
  232.  
  233.  
  234. begin { MAIN }
  235. writeln;
  236. writeln('Directory killer program.  By Jim Grinsfelder.');
  237. writeln;
  238. if (ParamCount = 1) then
  239.    begin
  240.    { Get current default directory. }
  241.    getdir(0, sOldDir);
  242.  
  243.    sTempStr := UPCASESTR(ParamStr(1));
  244.    if (PROCESSPATH(sTempStr)) then
  245.       begin
  246.       if (WARNING(sTempStr)) then
  247.          begin
  248.          DIRKILL(sTempStr);
  249.  
  250.          { Restore to current default directory if possible. }
  251.          {$I-} { Turn off I/O checking in case they killed old directory. }
  252.          chdir(sOldDir);
  253.          {$I+}
  254.          end { if }
  255.       else
  256.          begin
  257.          writeln;
  258.          writeln('DIRKILL aborted.  Nothing deleted.');
  259.          writeln;
  260.          end; { else }
  261.       end; { if }
  262.    end { if }
  263. else
  264.    begin
  265.    writeln;
  266.    writeln('Invalid parameters (or not enough parameters).');
  267.    writeln;
  268.    writeln('Usage:  DIRKILL \PATH.');
  269.    writeln;
  270.    end;
  271. end. { MAIN }
  272.